home *** CD-ROM | disk | FTP | other *** search
/ CDUTIL 13 / CDUTIL #13 Julio 1995.iso / windows / dbfast20 / misc / generic.prg < prev    next >
Encoding:
Text File  |  1993-11-16  |  7.5 KB  |  319 lines
  1. *Este programa se llama generico.prg
  2.  
  3. *Este programa fue modificado a partir de un original de dBASE.
  4. *Se ha a±adido un bucle de eventos, una casilla de selecci≤n y 
  5. *algunos botones. Una aplicaci≤n verdadera de Windows requerirφa
  6. *algunos elementos adicionales. Observe que este programa utiliza 
  7. *tambiΘn la clßusula VALID de dBFast de manera especial. dBFast 
  8. *permite utilizar la palabra clave "CHANGE" con una clßusula VALID. 
  9. *Si se utiliza esta sentencia, se eval·a s≤lo si el usuario cambia
  10. *realmente los datos. Aquφ la utilizamos para determinar el orden 
  11. *del φndice. Si el usuario introduce un n·mero de la seguridad 
  12. *social, asignamos un φndice al n·mero de seguridad social y 
  13. *realizamos las b·squedas en ese φndice. Si el usuario cambia el
  14. *nombre, creamos ese φndice (por defecto).  
  15. *
  16.  
  17. #define ACTIVEGETS     1
  18. #define READSAVE     2
  19. #define WAITING     3
  20. #define NORMAL         4
  21.  
  22. #define NO_EVENT            -1
  23. #define KEYBD_EVENT         1
  24. #define MENU_EVENT             2
  25. #define SELECTWINDOW_EVENT     3
  26. #define CLOSEWINDOW_EVENT     5
  27. #define BUTTON_EVENT         6
  28.  
  29. #define OUREDIT     1
  30. #define OURNEXT     2
  31. #define OURPREV     3
  32. #define OUREXIT     4
  33. #define OURNEW         5
  34. #define OURDELETE     6
  35.  
  36.  
  37.  
  38. SET PROCEDURE TO generic
  39.  
  40.  
  41. set deleted on
  42.  
  43. PUBLIC begread, mode
  44. STORE 1 TO begread
  45. SET EXIT VIDEO TO 112
  46.  
  47. CREATE BUTTON ' Siguiente ' AT 19,3
  48. CREATE BUTTON ' Anterior ' AT 19, 17
  49. CREATE BUTTON ' Borrar ' AT 19,30
  50. CREATE BUTTON ' Nuevo  ' AT 19,41
  51. CREATE BUTTON ' Cancelar ' AT 19,52
  52. CREATE BUTTON ' Editar ' AT 19,65
  53. mode = OUREDIT
  54.  
  55. DO PaintScreen
  56. DO dispinfo
  57.  
  58. set exit video to sayvideo()
  59.  
  60. DO WHILE .T.
  61.    ENABLE BUTTON ' Siguiente '
  62.    ENABLE BUTTON ' Anterior '
  63.    ENABLE BUTTON ' Borrar '
  64.    ENABLE BUTTON ' Nuevo  '
  65.    ENABLE BUTTON ' Cancelar '
  66.    ENABLE BUTTON ' Editar '
  67.  
  68.    STORE nombre TO mname
  69.    STORE nss TO mssn
  70.    *Observe el uso de la palabra CHANGE en los siguientes gets.
  71.    @ 4,11 GET mname VALID chkname(mname) CHANGE MESSAGE ;
  72.            'Introduzca el nombre que desea buscar' ;
  73.           ERROR 'Nombre no encontrado'
  74.    @ 4,58 GET mssn VALID chkssn(mssn) CHANGE MESSAGE ;
  75.          'Introduzca el n·mero de cuenta que desea buscar' ;
  76.          ERROR 'El n·mero de cuenta no existe'
  77.  
  78.    action = GetEvent(ACTIVEGETS,begread)
  79.    action = TranslateEvent(action)
  80.  
  81.    IF .NOT. doevent(action,.F.)
  82.       IF action = OUREXIT
  83.          EXIT
  84.       ENDIF
  85.       LOOP
  86.    ENDIF
  87.  
  88.    firstpass = .t.
  89.  
  90.    DO WHILE .T.
  91.       IF action = OURNEW
  92.          mode = OURNEW
  93.          APPEND BLANK
  94.          if firstpass
  95.            @ 4,11 GET nombre
  96.            @ 4,58 GET ssn
  97.          endif
  98.          DISABLE BUTTON ' Siguiente '
  99.          DISABLE BUTTON ' Anterior '
  100.          DISABLE BUTTON ' Borrar '
  101.          DISABLE BUTTON ' Nuevo  '
  102.          DISABLE BUTTON ' Editar '
  103.       ELSE
  104.          DISABLE BUTTON ' Editar '
  105.          DISABLE BUTTON ' Nuevo  '
  106.          @ 4,11 SAY nombre
  107.          @ 4,58 SAY nss
  108.          mode = OUREDIT
  109.       ENDIF
  110.         if firstpass
  111.             @  8,14 GET direccion
  112.             @  8,62 GET fecha MESSAGE 'Introduzca la fecha del ·ltimo contacto'
  113.             @ 10,14 GET ciudad
  114.             @ 12,14 GET provincia
  115.             @ 12,38 GET cod_postal
  116.             @ 10,54 GET notas editbox to 5,15
  117.           @ 16,49 GET activ0 CHECKBOX 'Activo'
  118.             @ 14,21 GET tel_ofic 
  119.             @ 16,21 GET tel_part 
  120.          endif
  121.  
  122.       action = GetEvent(READSAVE,0)
  123.       action = TranslateEvent(action)
  124.       IF doevent(action,.T.)
  125.          EXIT
  126.       ENDIF
  127.  
  128.       firstpass = .f.
  129.       update gets
  130.    ENDDO
  131.    clear gets
  132. ENDDO
  133.  
  134. RELEASE begread, mode
  135. CLOSE ALL
  136. RETURN
  137.  
  138. ********************************************
  139. PROCEDURE PaintScreen
  140. ********************************************
  141.  
  142. USE tnombre
  143. INDEX on nss to tnss
  144. INDEX on nombre to tnombre
  145. use tnombre index tnombre, tnss
  146.  
  147. color = sayvideo()
  148. *Leer el color elegido por el usuario, enmascarar el color de fondo y a±adir 1 para hacerlo azul
  149. color = bitand(240,color) + 1
  150. set say video to color
  151. center('Entrada y Modificaci≤n de Clientes',1,0,78,10)
  152. set color to
  153.  
  154. @ 4,3 SAY 'Nombre:'
  155. @ 4,43 SAY 'N·mero Cuenta:'
  156. @ 8,3 SAY 'Direcci≤n:'
  157. @ 10,3 SAY 'Ciudad:'
  158. @ 12,3 SAY 'Provincia:'
  159. @ 12,32 SAY 'C.P.:'
  160. @ 14,3 SAY 'Tel. Oficina:'
  161. @ 16,3 SAY 'Tel. Particular:'
  162. @ 8,47 SAY '┌lt. Contacto:'
  163. @ 10,47 SAY 'Notas'
  164. @  7,2 TO 17,73
  165. return
  166.  
  167.  
  168. ********************************************
  169. FUNCTION chkname
  170. ********************************************
  171. PARAMETER target
  172.  
  173.    SET INDEX TO tnombre
  174.    SEEK TRIM(target)
  175.    begread = 1  | Si conviene, cambia el campo get por defecto
  176.    IF .NOT. EOF()
  177.       GETNO(30)    | No se leen los caracteres por encima de este n·mero
  178.     ELSE
  179.       GO BOTTOM
  180.       RETURN(.F.)
  181.    ENDIF
  182. RETURN(.T.)
  183.  
  184.  
  185. ********************************************
  186. FUNCTION chkssn
  187. ********************************************
  188. PARAMETER target
  189.  
  190.    SET INDEX TO tnss
  191.    SEEK TRIM(target)
  192.    begread = 2  | Si conviene, cambia el campo get por defecto
  193.    IF .NOT. EOF()
  194.       GETNO(30)    | No se leen los caracteres por encima de este n·mero
  195.    ELSE
  196.       GO BOTTOM
  197.       RETURN(.F.)
  198.    ENDIF
  199. RETURN(.T.)
  200.  
  201.  
  202. ********************************************
  203. FUNCTION doevent
  204. ********************************************
  205. PARAMETER act, dflt
  206.  
  207.    DO CASE
  208.       CASE act = OUREXIT
  209.          IF mode = OUREDIT
  210.             GOTO CURRENT
  211.          ELSE
  212.             UNPEND
  213.          ENDIF
  214.          RETURN(dflt)
  215.       CASE act = 0              |Entrada incorrecta
  216.          RETURN(.F.)
  217.       CASE act = OURNEXT
  218.          SKIP
  219.          IF EOF()
  220.             SKIP -1
  221.          ENDIF
  222.          do dispinfo
  223.          RETURN(.f.)
  224.       CASE act = OURPREV
  225.          SKIP -1
  226.          IF BOF()
  227.             SKIP
  228.          ENDIF
  229.          DO dispinfo
  230.          RETURN(.F.)
  231.       CASE act = OURDELETE
  232.          DELETE
  233.          SKIP
  234.          IF EOF()
  235.             SKIP -1
  236.          ENDIF
  237.          DO dispinfo
  238.          RETURN(dflt)
  239.    ENDCASE
  240. RETURN(.T.)
  241.  
  242.  
  243. ********************************************
  244. PROCEDURE dispinfo
  245. ********************************************
  246.  
  247.  @ 8,14 SAY direccion
  248.  @ 10,14 SAY ciudad
  249.  @ 12,14 SAY provincia
  250.  @ 12,38 SAY cod_postal PICTURE '99999'
  251.  @ 14,21 SAY tel_ofic
  252.  @ 16,21 SAY tel_part 
  253.  @  8,62 SAY fecha
  254.  
  255. RETURN
  256.  
  257.  
  258. ********************************************
  259. function GetEvent
  260. ********************************************
  261. parameter emode, getstart
  262.  
  263.   do case
  264.     case emode = ACTIVEGETS
  265.       if getstart > 0
  266.         read starting with getstart
  267.       else
  268.         read
  269.       endif
  270.     case emode = READSAVE
  271.       read save
  272.     case emode = WAITING
  273.       @ 0,0 say
  274.       wait ""
  275.     otherwise                      |NORMAL
  276.       return(chkevent())
  277.    endcase
  278. return(event())
  279.  
  280.  
  281. ********************************************
  282. function TranslateEvent(ievent)
  283. ********************************************
  284. parameter ievent
  285.  
  286. do case
  287.   case ievent = KEYBD_EVENT
  288.     key = LASTKEY()
  289.     DO CASE
  290.       CASE key = 27
  291.         RETURN(OUREXIT)
  292.       CASE key = 530
  293.         RETURN(OURPREV)
  294.       CASE key = 536
  295.         RETURN(OURNEXT)
  296.       OTHERWISE
  297.         RETURN(OUREDIT)
  298.     ENDCASE
  299.   case ievent = BUTTON_EVENT           | evento de bot≤n
  300.     STORE BUTTON() TO btext
  301.     DO CASE
  302.       CASE btext =  ' Siguiente '
  303.         RETURN(OURNEXT)
  304.       CASE btext =  ' Anterior '
  305.         RETURN(OURPREV)
  306.       CASE btext =  ' Borrar '
  307.         RETURN(OURDELETE)
  308.       CASE btext =  ' Nuevo  '
  309.         RETURN(OURNEW)
  310.       CASE btext =  'Cancelar'
  311.         RETURN(OUREXIT)
  312.       CASE btext =  ' Editar '
  313.     ENDCASE
  314.  otherwise
  315.    BEEP
  316.    RETURN(0)
  317. endcase
  318. RETURN(OUREDIT)
  319.